home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_5.zip / adaed / nyudemos / screenio.ada < prev    next >
Text File  |  1992-09-01  |  3KB  |  126 lines
  1.  
  2. ----------------------------------------------------------------------
  3. --
  4. --              Screen Input Output Package
  5. --
  6. --                      written by
  7. --
  8. --                   Edmond Schonberg
  9. --                    David Shields
  10. --
  11. --                      Ada Project
  12. --                   Courant Institute
  13. --                  New York University
  14. --                   251 Mercer Street
  15. --                New York, New York  10012
  16. --
  17. -----------------------------------------------------------------------
  18.  
  19. with text_io;         use text_io;
  20. with semaphore;       use semaphore;
  21.  
  22. package screen_io is
  23.  
  24. -- These screen input output primitives assume that the terminal can
  25. -- function as a VT100 or, for the IBM PC, has ANSI.SYS installed
  26. -- as a screen driver.
  27.  
  28.     subtype row is integer range 1..25;
  29.     subtype column is integer range 1..80;
  30.  
  31.     procedure clear ;
  32.     procedure PUTS(s: string; r: row; c: column);
  33.     procedure PUTSN(s: string; n: integer; r: row; c: column);
  34.     procedure PUTC(ch: character; r: row; c: column);
  35.     procedure PUTCB(ch: character; r: row; c: column);
  36.     procedure fill_screen(c: character) ;
  37.  
  38. end screen_io;
  39.  
  40. with integer_text_io; use integer_text_io;
  41. package body screen_io is
  42.  
  43.     protect: ACCESS_BINARY_SEMAPHORE := new BINARY_SEMAPHORE;
  44.  
  45.     procedure clear is
  46.     begin
  47.         put(ASCII.ESC ); put("[2J") ;
  48.     end ;
  49.  
  50.     procedure PUT_INT(R: integer) is
  51.     digs: constant string := "0123456789";
  52.     d : integer := R;
  53.     begin
  54.     if d>=100 then
  55.         put(digs(d/100 + 1));
  56.             d := d mod 100;
  57.     end if;                
  58.     -- always write at least two digits (if setting screen position).
  59.     put(digs(d/10 + 1));
  60.     put(digs(d mod 10 + 1));
  61.     end;
  62.  
  63.     procedure SET_CURSOR(R: row := 1; C:column := 1) is
  64.       -- uses escape sequence ESC [ row ; column H
  65.     begin
  66.         put(ASCII.ESC); 
  67.         put('['); 
  68.         put_int(R); 
  69.         put( ';');  
  70.         put_int(C); 
  71.         put('H');
  72.     end SET_CURSOR;
  73.  
  74.     procedure PUTS(S: string; R: row; C: column) is
  75.         index: integer;
  76.     begin
  77.         PROTECT.P;
  78.         SET_CURSOR(R, C); put_line(S);
  79.         PROTECT.V;
  80.     end;
  81.  
  82.     procedure PUTSN(S: string; N: integer; R: row; C: column) is
  83.         index: integer;
  84.     -- put string and integer values
  85.     begin
  86.         PROTECT.P;
  87.         SET_CURSOR(R, C); put(S);
  88.     put_int(N);
  89.         put_line("   ");
  90.         PROTECT.V;
  91.     end;
  92.  
  93.     procedure PUTCB(CH: character ; R: row; C: column) is
  94.     -- put "emphasized" character 
  95.         index: integer;
  96.     begin
  97.         PROTECT.P;
  98.         SET_CURSOR(R, C); 
  99.     put(ASCII.ESC); 
  100.     put("[5m"); -- turn on blinking
  101.     put(CH);
  102.     put(ASCII.ESC); 
  103.     put_line("[0m"); -- turn off blinking
  104.         PROTECT.V;
  105.     end;
  106.  
  107.    procedure PUTC(Ch: character; R: row; C: column) is
  108.    begin
  109.       PROTECT.P;
  110.       SET_CURSOR(R, C); 
  111.       put(Ch); 
  112.       new_line;
  113.       PROTECT.V;
  114.    end PUTC; 
  115.  
  116.    procedure fill_screen(c: character) is
  117.        line : string(1..80) := (1..80 => c) ;
  118.    begin
  119.        for i in 2..23 loop
  120.           SET_CURSOR(i, 1); put_line(line) ;
  121.        end loop;
  122.    end fill_screen;
  123.  end screen_io;
  124.     
  125.  
  126.